home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / reader.c < prev    next >
C/C++ Source or Header  |  1993-06-16  |  6KB  |  297 lines
  1. /**
  2.   * Reader for feel. 
  3.   * Just reads tokens(via lex), and does some mangling...
  4.   ***/
  5.  
  6. #include <string.h>
  7. #include <ctype.h>
  8. #include "defs.h"
  9. #include "structs.h"
  10. #include "funcalls.h"
  11. #include "global.h"
  12. #include "symboot.h"
  13. #include "error.h"
  14.  
  15. #include "lex_global.h"
  16.  
  17. #define READBUG(x) 
  18.  
  19. static LispObject start_list(LispObject *stacktop, FILE *stream, int *len);
  20. static void end_list(LispObject *stacktop, FILE *stream, LispObject first, int *len);
  21. static LispObject this_object(LispObject *stacktop, int token);
  22. static LispObject read2(LispObject *stacktop,FILE *stream,int *len);
  23. static LispObject list2vector(LispObject *stacktop,int len, LispObject lst);
  24.  
  25. LispObject q_eof;
  26. LispObject current_input;
  27.  
  28. LispObject sys_read(LispObject *stackbase, FILE *stream)
  29. {
  30.   int dummy;
  31.   LispObject obj;
  32.  
  33.   yy_set_stream(stream);
  34.   obj = read2(stackbase,stream,&dummy);
  35.   
  36.   return obj;
  37. }
  38.  
  39. int reader_fclose(LispObject *stackbase, FILE *stream)
  40. {
  41. #ifdef WITH_FUDGE
  42.   {
  43.     extern int yy_close_stream(FILE *);
  44.  
  45.     return yy_close_stream(stream);
  46.   }
  47. #else
  48.   return system_fclose((stream->STREAM).handle);
  49. #endif
  50. }
  51.  
  52. static LispObject read2(LispObject *stacktop,FILE *stream,int *len)
  53. {
  54.   LispObject result, first,tmp;
  55.   int mylen, token;
  56.   
  57.   token=yylex(stacktop);
  58.   switch(token)
  59.     {
  60.     case OPEN_PAIR:
  61.       return(start_list(stacktop,stream,len));
  62.       break;
  63.  
  64.     case EXTENSION:        
  65.       first = read2(stacktop,stream,&mylen);
  66.       if (first==nil || is_cons(first))
  67.     return(list2vector(stacktop,mylen,first));
  68.       else
  69.     {
  70.       CallError(stacktop,"Bad extension syntax",nil,NONCONTINUABLE);
  71.       return nil;
  72.     }
  73.       break;
  74.  
  75.     case CLOSE_PAIR:
  76.       fprintf(stderr,"Spurious closing parenthisis ignored");
  77.       return nil;
  78.       break;
  79.  
  80.     case WRAPPER:
  81.       STACK_TMP(pptok.lispval);
  82.       first=read2(stacktop,stream,&mylen);
  83.       first=EUCALL_2(Fn_cons,first,nil);
  84.       UNSTACK_TMP(tmp);
  85.       first=EUCALL_2(Fn_cons,tmp,first);
  86.       *len=2;
  87.       return first;
  88.       break;
  89.       
  90.     case DOT:
  91.       CallError(stacktop,"Bad list..",nil,NONCONTINUABLE);
  92.       return nil; /* Never */
  93.       break;
  94.  
  95.     default:
  96.       return(this_object(stacktop,token));
  97.     }
  98.   
  99. }
  100.  
  101. static LispObject start_list(LispObject *stacktop, FILE *stream, int *len)
  102. {
  103.   LispObject next;
  104.   int mylen, next_token;
  105.  
  106.   *len=0;
  107.   next_token=yylex(stacktop);
  108.  
  109.   switch (next_token)
  110.     {
  111.     case OPEN_PAIR:
  112.       next=start_list(stacktop,stream,&mylen);
  113.       next=EUCALL_2(Fn_cons,next,nil);
  114.       *len=1;
  115.       STACK_TMP(next);
  116.       end_list(stacktop,stream,next,len);
  117.       UNSTACK_TMP(next);
  118.       return next;
  119.  
  120.     case EXTENSION:
  121.       next=read2(stacktop,stream,&mylen);
  122.       if  (next!=nil && !is_cons(next))
  123.     CallError(stacktop,"Bad extension syntax",nil,NONCONTINUABLE);
  124.       else
  125.     {
  126.       next=list2vector(stacktop,mylen,next);
  127.       next=EUCALL_2(Fn_cons,next,nil);
  128.       STACK_TMP(next);
  129.       *len=1;
  130.       end_list(stacktop,stream,next,len);
  131.       UNSTACK_TMP(next);
  132.       return next;
  133.     }
  134.       break;
  135.  
  136.     case CLOSE_PAIR:
  137.       return nil;
  138.  
  139.     case WRAPPER:
  140.       STACK_TMP(pptok.lispval);
  141.       next=read2(stacktop,stream,&mylen);
  142.       next=EUCALL_2(Fn_cons,next,nil);
  143.       UNSTACK_TMP(pptok.lispval);
  144.       next=EUCALL_2(Fn_cons,pptok.lispval,next);
  145.       next=EUCALL_2(Fn_cons,next,nil);
  146.       STACK_TMP(next);
  147.       *len=1;
  148.       end_list(stacktop,stream,next,len);
  149.       UNSTACK_TMP(next);
  150.       return next;
  151.       break;
  152.  
  153.  
  154.     case DOT:
  155.       CallError(stacktop,"Misplaced dot",nil,NONCONTINUABLE);
  156.       break;
  157.  
  158.     case END_OF_STREAM:
  159.       CallError(stacktop,"Unexpected end of file",nil,NONCONTINUABLE);
  160.       break;
  161.  
  162.    default:
  163.       next = this_object(stacktop,next_token);
  164.       next= EUCALL_2(Fn_cons,next,nil);
  165.       ++*len;
  166.       STACK_TMP(next);
  167.       end_list(stacktop,stream,next,len); 
  168.       UNSTACK_TMP(next);
  169.       return next;
  170.     }
  171. }
  172.  
  173. static void end_list(LispObject *stacktop, FILE *stream, LispObject first, int *len)
  174. {
  175.   LispObject *stackbase;
  176.   int token;
  177.   LispObject next,tmp;
  178.   int mylen;
  179.   
  180.   stackbase=stacktop;
  181.  
  182.   ARG_0(stackbase)=first; stacktop++;
  183.   STACK_TMP(first);
  184.   while ( (token=yylex(stacktop))!=CLOSE_PAIR)
  185.     {
  186.       switch (token)
  187.     {
  188.     case OPEN_PAIR:
  189.       next=start_list(stacktop,stream,&mylen);
  190.       next=EUCALL_2(Fn_cons,next,nil);    
  191.       UNSTACK_TMP(first);
  192.       CDR(first)=next;
  193.       first=next;
  194.       ++*len;
  195.       break;
  196.  
  197.     case EXTENSION:
  198.       next=read2(stacktop,stream,&mylen);
  199.       if  (next!=nil && !is_cons(next))
  200.         CallError(stacktop,"Bad extension syntax",next,NONCONTINUABLE);
  201.       else
  202.         {
  203.           next=list2vector(stacktop,mylen,next);
  204.           next=EUCALL_2(Fn_cons,next,nil);
  205.           UNSTACK_TMP(first);
  206.           CDR(first)=next;
  207.           first=next;
  208.           ++*len;
  209.         }
  210.       break;
  211.  
  212.     case WRAPPER:
  213.       STACK_TMP(pptok.lispval);
  214.       next=read2(stacktop,stream,&mylen);
  215.       next=EUCALL_2(Fn_cons,next,nil);
  216.       UNSTACK_TMP(tmp);
  217.       next=EUCALL_2(Fn_cons,tmp,next);
  218.       next=EUCALL_2(Fn_cons,next,nil);
  219.       UNSTACK_TMP(first);
  220.       CDR(first)=next;
  221.       first=next;
  222.       ++*len;
  223.       break;
  224.  
  225.     case DOT:
  226.       next=read2(stacktop,stream,&mylen);
  227.       UNSTACK_TMP(first);
  228.       CDR(first)=next;
  229.       if (is_cons(next))
  230.         {
  231.           if (mylen<0) 
  232.         *len=mylen-*len;
  233.           else
  234.         *len+=mylen;
  235.         }
  236.       else
  237.         *len= -*len;
  238.       break;
  239.  
  240.     case END_OF_STREAM:
  241.       CallError(stacktop,"Unexpected end of file",nil,NONCONTINUABLE);
  242.       break;
  243.  
  244.     default:
  245.       next=this_object(stacktop,token);
  246.       next=EUCALL_2(Fn_cons,next,nil);
  247.       UNSTACK_TMP(first);
  248.       CDR(first)=next;
  249.       first=next;
  250.       ++*len;
  251.       break;
  252.     }    
  253.       STACK_TMP(first);
  254.     }
  255. }
  256.  
  257. static LispObject this_object(LispObject *stacktop, int token)
  258. {
  259.   switch (token)
  260.     {
  261.       /** Literal objects **/
  262.     case CHARACTER:    
  263.     case INTEGER:
  264.     case FLOAT:
  265.     case RATIONAL: /* XXX: Still need to fix this */
  266.     case STRING:
  267.     case IDENTIFIER:
  268.       return pptok.lispval;
  269.       break;
  270.       
  271.     case END_OF_STREAM:
  272.       return q_eof;
  273.       break;
  274.  
  275.     default:
  276.       CallError(stacktop,"Bad token type",allocate_integer(stacktop,token),NONCONTINUABLE);
  277.     }
  278. }
  279.  
  280. static LispObject list2vector(LispObject *stacktop,int len, LispObject lst)
  281. {
  282.   LispObject new;
  283.   int i;
  284.  
  285.   if (len<0)
  286.     CallError(stacktop,"bad vector syntax",lst,NONCONTINUABLE);
  287.   
  288.   new=allocate_vector(stacktop,len);
  289.  
  290.   for (i=0 ; i<len ; i++)
  291.     {    
  292.       vref(new,i)=CAR(lst);
  293.       lst=CDR(lst);
  294.     }    
  295.   return new;
  296. }
  297.